Overlap matrix heatmap

Reproducing heatmap from issues/28#issuecomment-636012185

Library

library(SEtools)
library(pheatmap)
library(dplyr)
library(ComplexHeatmap)
library(RColorBrewer)
library(DT)

Data

mat <- readRDS("input/overlap_matrix.rds")

mat$isProm <- (abs(mat$distanceToTSS) < 5000) / 2 + (abs(mat$distanceToTSS) < 2500) / 2

fields <- c(
  "isProm", "diffAccessibility-logFC", "RNA_PND8_vs_PND15_logFC",
  "RNA_PND15_vs_Adult_logFC", "BS_PND7_meth", "BS_PND14_meth", "BS_PNW8_meth",
  grep("ChIP", colnames(mat), value = TRUE)
)
mat2 <- mat[, fields]
mat2 <- do.call(cbind, lapply(mat2, as.numeric))

se <- getBreaks(mat2, split.prop = 0.96, 100)
cols <- colorRampPalette(c("blue", "black", "yellow"))(101)
mat2 <- sortRows(mat2, z = FALSE)


prom <- mat2[mat2[, 1] > 0, ]
distal <- mat2[mat2[, 1] == 0, ]
pheatmap(prom,
  color = cols, breaks = se,
  cluster_cols = FALSE, cluster_rows = FALSE
)

Subset data

Level 1

# Distal
mat$isDistal <- abs(mat$distanceToTSS) > 2500

# Proximal Active
mat$isProximalActive <- !is.na(mat$RNA_PND15_vs_Adult_AveExpr)

# # Proximal Inactive
# mat$isProximalInactive <- abs(mat$RNA_PND15_vs_Adult_logFC) < 1 & mat$RNA_PND15_vs_Adult_adj.P.Val > 0.05

Level 2

mat$accUp <- mat$`diffAccessibility-logFC` > 0
# mat$accDown <- mat$`diffAccessibility-logFC` < 0

Level 3

mat$expUp <- mat$RNA_PND15_vs_Adult_logFC > 0
# mat$expDown <- mat$RNA_PND15_vs_Adult_logFC < 0

Level 4

# H3K4me3
mat$H3K4me3 <- mat$ChIP_PNW8_H3K4me3

# H3K27ac and not H3K27me or H3K4me3
mat$H3K27acOnly <- (mat$ChIP_PNW8_H3K27ac == TRUE) & (mat$ChIP_PNW8_H3K27me3 == FALSE) & (mat$ChIP_PNW8_H3K4me3 == FALSE)

# H3K27me and not H3K27ac or H3K4me3
mat$H3K27me3Only <- (mat$ChIP_PNW8_H3K27me3 == TRUE) & (mat$ChIP_PNW8_H3K27ac == FALSE) & (mat$ChIP_PNW8_H3K4me3 == FALSE)

rownames(mat) <- mat$Name

Split matrix

# select the columns according to which we want to split
mat2 <- mat[, 74:80]
# for distal sites, we don't want to look at RNA:
mat2$isProximalActive[mat2$isDistal] <- NA
mat2$expUp[mat2$isDistal] <- NA

splitAndName <- function(o) {
  s <- split(o, apply(o, 1, collapse = " ", paste))
  names(s) <- as.character(sapply(s, FUN = function(x) {
    x <- x[1, , drop = FALSE]
    y <- c(
      ifelse(x$isDistal, "distal", "proximal"),
      ifelse(x$isProximalActive, "active", "inactive"),
      ifelse(x$accUp, "accUp", "accDown"),
      ifelse(x$expUp, "rnaUp", "rnaDown")
    )
    if (!is.null(x$H3K4me3)) {
      y <- c(
        y,
        ifelse(x$H3K4me3, "H3K4me3", NA),
        ifelse(x$H3K27acOnly, "H3K27ac", NA),
        ifelse(x$H3K27meOnly, "H3K27me", NA)
      )
    }
    paste(y[!is.na(y)], collapse = ".")
  }))
  s
}

# split without the histone marks
s1 <- splitAndName(mat2[, 1:4])
# sapply(s1, nrow)

# very fine-grained splitting, using all columns:
s2 <- splitAndName(mat2)
# sapply(s2, nrow)

s3 <- lapply(s2, function(x) data.frame(Name = rownames(x), x))

df <- plyr::ldply(s3, data.frame)
colnames(df)[1] <- "anno"
rownames(df) <- df$Name

sp_df <- split(x = df, f = df$anno)

Heatmap

All regions

tab <- sortRows(df[, -c(1:2)], z = FALSE)


col <- c(brewer.pal(n = 3, name = "Set1")[1:2], "grey")

lgd <- Legend(
  labels = c("TRUE", "FALSE", "NA"), legend_gp = gpar(fill = col[c(2, 1, 3)]), title = "Status",
  title_gp = gpar(col = "Blue", fontsize = 14)
)

draw(
  Heatmap(
    matrix = data.matrix(df[, -c(1:2)]),
    col = col,
    cluster_rows = FALSE, cluster_columns = FALSE,
    show_row_names = FALSE, row_order = rownames(tab),
    row_split = df$anno, name = "All regions", show_heatmap_legend = FALSE
  ),
  heatmap_legend_list = lgd
)

Individual plots

make_DT <- function(df) {
  df <- data.frame(df, stringsAsFactors = F, check.names = F)
  DT::datatable(
    df,
    rownames = F,
    filter = "top",
    extensions = c("Buttons", "ColReorder"),
    options = list(
      searching = FALSE,
      pageLength = 5,
      scrollX = T,
      buttons = c("copy", "csv", "excel", "pdf", "print"),
      colReorder = list(realtime = FALSE),
      dom = "fltBip",
      width = "8px", height = "5px"
    )
  )
}
for (i in 1:length(sp_df)) {
# for (i in 1:24) {
  n <- names(sp_df)[i]

  cat("### ", n, "{.tabset .tabset-pills} \n\n\n")

  cat("#### Heatmap \n\n\n")

  draw(
    Heatmap(
      matrix = data.matrix(sp_df[[i]][, -c(1:2)]),
      col = col, name = "Values",
      cluster_rows = FALSE, cluster_columns = FALSE,
      column_title = n,
      show_row_names = FALSE,
      show_heatmap_legend = FALSE
    ),
    heatmap_legend_list = lgd
  )

  cat("\n\n\n")
  
  pdf(file = paste0("./output/plots/", n, ".pdf"), width = 11, height = 8.5)
  draw(
    Heatmap(
      matrix = data.matrix(sp_df[[i]][, -c(1:2)]),
      col = col, name = "Values",
      cluster_rows = FALSE, cluster_columns = FALSE,
      column_title = n,
      show_row_names = FALSE,
      show_heatmap_legend = FALSE
    ),
    heatmap_legend_list = lgd
  )
  dev.off()

  cat("\n\n\n")

  cat("#### Table \n\n\n")

  tab <- inner_join(mat[, 1:73], sp_df[[i]])

  print(htmltools::tagList(make_DT(tab)))

  cat("\n\n\n")
  
  writexl::write_xlsx(x = tab, path = paste0("./output/tables/", n, ".xlsx"), col_names = T, format_headers = T)

}

distal.accDown

Heatmap

Table

distal.accDown.H3K27ac

Heatmap

Table

distal.accDown.H3K4me3

Heatmap

Table

distal.accUp

Heatmap

Table

distal.accUp.H3K27ac

Heatmap

Table

distal.accUp.H3K4me3

Heatmap

Table

proximal.active.accDown.rnaDown

Heatmap

Table

proximal.active.accDown.rnaDown.H3K27ac

Heatmap

Table

proximal.active.accDown.rnaDown.H3K4me3

Heatmap

Table

proximal.active.accDown.rnaUp

Heatmap

Table

proximal.active.accDown.rnaUp.H3K27ac

Heatmap

Table

proximal.active.accDown.rnaUp.H3K4me3

Heatmap

Table

proximal.active.accUp.rnaDown

Heatmap

Table

proximal.active.accUp.rnaDown.H3K27ac

Heatmap

Table

proximal.active.accUp.rnaDown.H3K4me3

Heatmap

Table

proximal.active.accUp.rnaUp

Heatmap

Table

proximal.active.accUp.rnaUp.H3K27ac

Heatmap

Table

proximal.active.accUp.rnaUp.H3K4me3

Heatmap

Table

proximal.inactive.accDown

Heatmap

Table

proximal.inactive.accDown.H3K27ac

Heatmap

Table

proximal.inactive.accDown.H3K4me3

Heatmap

Table

proximal.inactive.accUp

Heatmap

Table

proximal.inactive.accUp.H3K27ac

Heatmap

Table

proximal.inactive.accUp.H3K4me3

Heatmap

Table

Save objects

save(df, sp_df, file = "output/overlap_tables.RData")

SessionInfo

devtools::session_info() %>%
  details::details()

─ Session info ───────────────────────────────────────────────────────────────
 setting  value                       
 version  R version 3.6.2 (2019-12-12)
 os       Ubuntu 16.04.6 LTS          
 system   x86_64, linux-gnu           
 ui       X11                         
 language (EN)                        
 collate  en_US.UTF-8                 
 ctype    en_US.UTF-8                 
 tz       Europe/Zurich               
 date     2020-06-08                  

─ Packages ───────────────────────────────────────────────────────────────────
 package              * version    date       lib
 assertthat             0.2.1      2019-03-21 [1]
 backports              1.1.7      2020-05-13 [1]
 Biobase                2.46.0     2019-10-29 [1]
 BiocGenerics           0.32.0     2019-10-29 [1]
 BiocParallel           1.20.1     2019-12-21 [1]
 bitops                 1.0-6      2013-08-17 [1]
 bookdown               0.18       2020-03-05 [1]
 callr                  3.4.3      2020-03-28 [1]
 caTools                1.18.0     2020-01-17 [1]
 circlize               0.4.9      2020-04-30 [1]
 cli                    2.0.2      2020-02-28 [1]
 clue                   0.3-57     2019-02-25 [1]
 cluster                2.1.0      2019-06-19 [1]
 codetools              0.2-16     2018-12-24 [1]
 colorspace             1.4-1      2019-03-18 [1]
 ComplexHeatmap       * 2.2.0      2019-10-29 [1]
 crayon                 1.3.4      2017-09-16 [1]
 curl                   4.3        2019-12-02 [1]
 data.table             1.12.8     2019-12-09 [1]
 DelayedArray           0.12.3     2020-04-09 [1]
 dendextend             1.13.4     2020-02-28 [1]
 desc                   1.2.0      2018-05-01 [1]
 devtools               2.3.0      2020-04-10 [1]
 digest                 0.6.25     2020-02-23 [1]
 dplyr                * 0.8.5      2020-03-07 [1]
 DT                   * 0.13       2020-03-23 [1]
 edgeR                  3.28.1     2020-02-26 [1]
 ellipsis               0.3.1      2020-05-15 [1]
 evaluate               0.14       2019-05-28 [1]
 fansi                  0.4.1      2020-01-08 [1]
 foreach                1.5.0      2020-03-30 [1]
 fs                     1.4.1      2020-04-04 [1]
 gclus                  1.3.2      2019-01-07 [1]
 gdata                  2.18.0     2017-06-06 [1]
 GenomeInfoDb           1.22.1     2020-03-27 [1]
 GenomeInfoDbData       1.2.2      2019-11-18 [1]
 GenomicRanges          1.38.0     2019-10-29 [1]
 GetoptLong             0.1.8      2020-01-08 [1]
 ggplot2                3.3.0      2020-03-05 [1]
 GlobalOptions          0.1.1      2019-09-30 [1]
 glue                   1.4.1      2020-05-13 [1]
 gplots                 3.0.3      2020-02-25 [1]
 gridExtra              2.3        2017-09-09 [1]
 gtable                 0.3.0      2019-03-25 [1]
 gtools                 3.8.2      2020-03-31 [1]
 htmltools              0.4.0      2019-10-04 [1]
 htmlwidgets            1.5.1      2019-10-08 [1]
 IRanges                2.20.2     2020-01-13 [1]
 iterators              1.0.12     2019-07-26 [1]
 jsonlite               1.6.1      2020-02-02 [1]
 KernSmooth             2.23-16    2019-10-15 [1]
 knitr                  1.28       2020-02-06 [1]
 lattice                0.20-41    2020-04-02 [1]
 lifecycle              0.2.0      2020-03-06 [1]
 limma                  3.42.2     2020-02-03 [1]
 locfit                 1.5-9.4    2020-03-25 [1]
 magrittr               1.5        2014-11-22 [1]
 MASS                   7.3-51.5   2019-12-20 [1]
 Matrix                 1.2-18     2019-11-27 [1]
 matrixStats            0.56.0     2020-03-13 [1]
 memoise                1.1.0.9000 2020-05-06 [1]
 munsell                0.5.0      2018-06-12 [1]
 openxlsx               4.1.4      2019-12-06 [1]
 pheatmap             * 1.0.12     2019-01-04 [1]
 pillar                 1.4.4      2020-05-05 [1]
 pkgbuild               1.0.8      2020-05-07 [1]
 pkgconfig              2.0.3      2019-09-22 [1]
 pkgload                1.0.2      2018-10-29 [1]
 png                    0.1-7      2013-12-03 [1]
 prettyunits            1.1.1      2020-01-24 [1]
 processx               3.4.2      2020-02-09 [1]
 ps                     1.3.3      2020-05-08 [1]
 purrr                  0.3.4      2020-04-17 [1]
 R6                     2.4.1      2019-11-12 [1]
 randomcoloR            1.1.0.1    2019-11-24 [1]
 RColorBrewer         * 1.1-2      2014-12-07 [1]
 Rcpp                   1.0.4.6    2020-04-09 [1]
 RCurl                  1.98-1.2   2020-04-18 [1]
 registry               0.5-1      2019-03-05 [1]
 remotes                2.1.1      2020-02-15 [1]
 rjson                  0.2.20     2018-06-08 [1]
 rlang                  0.4.6      2020-05-02 [1]
 rmarkdown              2.1        2020-01-20 [1]
 rmdformats             0.4.0      2020-06-07 [1]
 rprojroot              1.3-2      2018-01-03 [1]
 Rtsne                  0.15       2018-11-10 [1]
 S4Vectors              0.24.4     2020-04-09 [1]
 scales                 1.1.1      2020-05-11 [1]
 seriation              1.2-8      2019-08-27 [1]
 sessioninfo            1.1.1      2018-11-05 [1]
 SEtools              * 1.2.1      2020-06-03 [1]
 shape                  1.4.4      2018-02-07 [1]
 stringi                1.4.6      2020-02-17 [1]
 stringr                1.4.0      2019-02-10 [1]
 SummarizedExperiment   1.16.1     2019-12-19 [1]
 testthat               2.3.2      2020-03-02 [1]
 tibble                 3.0.1      2020-04-20 [1]
 tidyselect             1.0.0      2020-01-27 [1]
 TSP                    1.1-10     2020-04-17 [1]
 usethis                1.6.1      2020-04-29 [1]
 V8                     3.0.2      2020-03-14 [1]
 vctrs                  0.3.0      2020-05-11 [1]
 viridis                0.5.1      2018-03-29 [1]
 viridisLite            0.3.0      2018-02-01 [1]
 withr                  2.2.0      2020-04-20 [1]
 xfun                   0.13       2020-04-13 [1]
 XVector                0.26.0     2019-10-29 [1]
 yaml                   2.2.1      2020-02-01 [1]
 zip                    2.0.4      2019-09-01 [1]
 zlibbioc               1.32.0     2019-10-29 [1]
 source                          
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.2)                  
 Bioconductor                    
 Bioconductor                    
 Bioconductor                    
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.1)                  
 Bioconductor                    
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.1)                  
 Bioconductor                    
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.2)                  
 Bioconductor                    
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.1)                  
 Bioconductor                    
 Bioconductor                    
 Bioconductor                    
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.1)                  
 Bioconductor                    
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.2)                  
 Bioconductor                    
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.2)                  
 Github (r-lib/memoise@4aefd9f)  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.2)                  
 Github (juba/rmdformats@94cd7a3)
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.1)                  
 Bioconductor                    
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.1)                  
 Bioconductor                    
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.1)                  
 Bioconductor                    
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.1)                  
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.2)                  
 Bioconductor                    
 CRAN (R 3.6.2)                  
 CRAN (R 3.6.1)                  
 Bioconductor                    

[1] /home/ubuntu/R/x86_64-pc-linux-gnu-library/3.6
[2] /usr/local/lib/R/site-library
[3] /usr/lib/R/site-library
[4] /usr/lib/R/library